﻿Imports Microsoft.VisualBasic
Imports System.Data
Imports dooll.Config
Imports System.Text.RegularExpressions

REM 数据库连接管理

Public Class MsSql
    Implements IDisposable

    Private mConn As SqlClient.SqlConnection
    Private UriKey As String = "default"
    Private mErrMessage As String

    Private ReadOnly Property Conn() As SqlClient.SqlConnection
        Get
            If mConn Is Nothing Then
                mConn = GetSqlConn()
            End If
            Return mConn
        End Get
    End Property

#Region "过程"

    Sub New()
        If System.Web.HttpContext.Current Is Nothing Then
            UriKey = "default"
        Else
            UriKey = System.Web.HttpContext.Current.Request.Url.Host
            Dim mHostItem As HostItem = HostsConfig.Hosts.Find(UriKey)
            If Not mHostItem Is Nothing AndAlso Not String.IsNullOrEmpty(mHostItem.DSN) Then
                UriKey = mHostItem.DSN
            End If
            mHostItem = Nothing
        End If
    End Sub

    Sub New(ByVal SQLKey As String)
        UriKey = SQLKey
    End Sub

    REM 打开数据连接
    Private Sub Open()
        If mConn.State = ConnectionState.Closed Then
            Try
                mConn.Open()
            Catch ex As Exception
                mErrMessage = "数据库无法打开"
            End Try
        End If
    End Sub

    REM 关闭数据连接
    Private Sub Close()
        If Not mConn Is Nothing Then
            If mConn.State = ConnectionState.Open Then
                mConn.Close()
            End If
        End If
    End Sub

#End Region

#Region "自定义属性"

    Public ReadOnly Property ErrMessage() As String
        Get
            Return mErrMessage
        End Get
    End Property

    Private Shared ReadOnly Property ConnString(ByVal fKey As String) As String
        Get

            If System.Configuration.ConfigurationManager.ConnectionStrings.Item(fKey) Is Nothing Then
                If System.Configuration.ConfigurationManager.ConnectionStrings("default") Is Nothing Then
                    Return Nothing
                End If
                Return System.Configuration.ConfigurationManager.ConnectionStrings("default").ConnectionString
            End If
            Return System.Configuration.ConfigurationManager.ConnectionStrings.Item(fKey).ConnectionString
        End Get
    End Property

#End Region

#Region "执行函数: ExecSql , ExecProc"

    REM 执行Sql语句,返回XmlReader 对象
    Public Sub ExecSql(ByVal Sql As String, ByRef pXmlReader As System.Xml.XPath.XPathDocument)
        Using SqlCmd As SqlClient.SqlCommand = GetSqlCmd(Sql)
            Try
                Open()
                pXmlReader = New Xml.XPath.XPathDocument(SqlCmd.ExecuteXmlReader)
                REM 关闭连接
                Close()
                SqlCmd.Dispose()
            Catch ex As Exception
                pXmlReader = Nothing
                mErrMessage = ex.Message
            End Try
        End Using
    End Sub

    REM 执行Sql语句,返回状态值
    Public Function ExecSql(ByVal Sql As String, ByVal bClose As Boolean) As Integer
        Dim ReturnValue As Integer
        Using SqlCmd As SqlClient.SqlCommand = GetSqlCmd(Sql)
            Try
                Open()
                ReturnValue = SqlCmd.ExecuteNonQuery()
                REM 关闭连接

                If bClose Then Close()
                SqlCmd.Dispose()
            Catch ex As Exception
                ReturnValue = -100
                mErrMessage = ex.Message
            End Try
        End Using
        Return ReturnValue
    End Function

    Public Function ExecSql(ByVal Sql As String) As Integer
        Return ExecSql(Sql, True)
    End Function

    REM ---------------------------------------------------存储过程操作区-----------------------------------------

    REM 执行无参数存储过程
    Public Function ExecProc(ByVal ProcName As String) As Integer
        Dim ReturnValue As Integer
        Using SqlCmd As SqlClient.SqlCommand = GetSqlCmd(ProcName)
            Try
                Open()
                SqlCmd.ExecuteNonQuery()
                ReturnValue = CType(SqlCmd.Parameters("ReturnValue").Value, Integer)
                REM 关闭连接
                Close()
                SqlCmd.Dispose()
            Catch ex As Exception
                mErrMessage = ex.Message
            End Try
        End Using
        Return ReturnValue
    End Function

    REM 执行带参数输入存储过程
    Public Function ExecProc(ByVal ProcName As String, ByVal Params As SqlClient.SqlParameter()) As Integer
        Dim ReturnValue As Integer
        Using SqlCmd As SqlClient.SqlCommand = GetSqlCmd(ProcName, Params)
            Try
                Open()
                SqlCmd.ExecuteNonQuery()
                ReturnValue = CType(SqlCmd.Parameters("ReturnValue").Value, Integer)
                REM 关闭连接
                Close()
                SqlCmd.Dispose()
            Catch ex As Exception
                mErrMessage = ex.Message
            End Try
        End Using
        Return ReturnValue
    End Function

    REM 执行无参数,
    Public Function ExecProc(ByVal ProcName As String, ByRef pXmlReader As System.Xml.XmlReader) As Integer
        Return ExecProc(ProcName, Nothing, pXmlReader)
    End Function

    REM 执行带参数输入,XmlReader
    Public Function ExecProc(ByVal ProcName As String, ByVal Params As SqlClient.SqlParameter(), ByRef pXmlReader As System.Xml.XmlReader) As Integer
        Dim ReturnValue As Integer
        Using SqlCmd As SqlClient.SqlCommand = GetSqlCmd(ProcName, Params)
            Try
                Open()
                Dim XmlSet As New System.Xml.XmlReaderSettings
                XmlSet.ConformanceLevel = System.Xml.ConformanceLevel.Auto
                XmlSet.CheckCharacters = False
                XmlSet.CloseInput = False
                pXmlReader = Xml.XmlReader.Create(SqlCmd.ExecuteXmlReader, XmlSet)
                ReturnValue = CType(SqlCmd.Parameters("ReturnValue").Value, Integer)
                REM 关闭连接
                Close()
                SqlCmd.Dispose()
            Catch ex As Exception
                pXmlReader = Nothing
                mErrMessage = ex.Message
            End Try
        End Using
        Return ReturnValue
    End Function

    REM 执行无参数,SqlDataReader
    Public Function ExecProc(ByVal ProcName As String, ByRef pXmlReader As DataSet, ByVal TabelName As String) As Integer
        Return ExecProc(ProcName, Nothing, pXmlReader, TabelName)
    End Function

    REM 执行参数SqlDataReader
    Public Function ExecProc(ByVal ProcName As String, ByVal Params As SqlClient.SqlParameter(), ByRef pXmlReader As DataSet, ByVal TabelName As String) As Integer
        Dim ReturnValue As Integer
        Using SqlCmd As SqlClient.SqlCommand = GetSqlCmd(ProcName, Params)
            Try
                Open()
                pXmlReader.Load(SqlCmd.ExecuteReader, LoadOption.OverwriteChanges, TabelName)
                ReturnValue = CType(SqlCmd.Parameters("ReturnValue").Value, Integer)
                REM 关闭连接
                Close()
                SqlCmd.Dispose()
            Catch ex As Exception
                ReturnValue = -500
                pXmlReader = Nothing
                mErrMessage = ex.Message
            End Try
        End Using
        Return ReturnValue
    End Function

    REM 执行带参数输入,XmlDocument
    Public Function ExecProc(ByVal ProcName As String, ByVal Params As SqlClient.SqlParameter(), ByRef pXmlDocument As System.Xml.XmlDocument) As Integer
        Dim ReturnValue As Integer
        Using SqlCmd As SqlClient.SqlCommand = GetSqlCmd(ProcName, Params)
            Try
                Open()
                If pXmlDocument Is Nothing Then
                    pXmlDocument = New System.Xml.XmlDocument
                End If
                Dim XmlReader As Xml.XmlReader = SqlCmd.ExecuteXmlReader
                pXmlDocument.Load(XmlReader)
                XmlReader.Close()
                XmlReader = Nothing
                ReturnValue = CType(SqlCmd.Parameters("ReturnValue").Value, Integer)
                REM 关闭连接
                Close()
                SqlCmd.Dispose()
            Catch ex As Exception
                ReturnValue = -500
                pXmlDocument = Nothing
                mErrMessage = ex.Message
            End Try
        End Using
        Return ReturnValue
    End Function

    ''' <summary>
    ''' 执行带参数输入
    ''' </summary>
    ''' <param name="ProcName">存储过程</param>
    ''' <param name="Params">参数组</param>
    ''' <param name="pXPathDoc">可返回 XPathDocument</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function ExecProc(ByVal ProcName As String, ByVal Params As SqlClient.SqlParameter(), ByRef pXPathDoc As System.Xml.XPath.XPathDocument) As Integer
        Dim ReturnValue As Integer
        Using SqlCmd As SqlClient.SqlCommand = GetSqlCmd(ProcName, Params)
            Try
                Open()
                'ExecSql("Set ARITHABORT ON", False)
                Dim XmlReader As Xml.XmlReader = SqlCmd.ExecuteXmlReader
                pXPathDoc = New System.Xml.XPath.XPathDocument(XmlReader)
                XmlReader.Close()
                XmlReader = Nothing
                ReturnValue = CType(SqlCmd.Parameters("ReturnValue").Value, Integer)
                REM 关闭连接
                Close()
                SqlCmd.Dispose()
            Catch ex As Exception
                pXPathDoc = Nothing
                ReturnValue = -500
                mErrMessage = ex.Message
            End Try
        End Using
        Return ReturnValue
    End Function

    ''' <summary>
    ''' 执行存储过程函数返回值
    ''' </summary>
    ''' <param name="ProcName">存储过程</param>
    ''' <param name="Params">参数数组</param>
    ''' <returns>return 返回值</returns>
    ''' <remarks></remarks>
    Public Function ExecProc(ByVal ProcName As String, ByVal Params As SqlClient.SqlParameter(), ByRef ScalarValue As String) As Integer
        Dim ReturnValue As Integer
        Using SqlCmd As SqlClient.SqlCommand = GetSqlCmd(ProcName, Params)
            Try
                Open()
                ScalarValue = SqlCmd.ExecuteScalar()
                ReturnValue = CType(SqlCmd.Parameters("ReturnValue").Value, String)
                REM 关闭连接
                Close()
                SqlCmd.Dispose()
            Catch ex As Exception
                ReturnValue = -500
                mErrMessage = ex.Message
            End Try
        End Using
        Return ReturnValue
    End Function



#End Region

#Region "外部函数 : GetListXml , GetSpListXml"
    REM 取得List数据,Xml格式
    Public Function GetListXml(ByVal fnQueryTable As String, ByVal fnPageSize As Integer, ByVal fnPageCurrent As Long, ByVal fnFdShow As String, ByVal fnFdOrder As String, ByVal fnWhere As String, ByRef pXmlDoc As System.Xml.XmlReader) As Long
        Dim Params(6) As SqlClient.SqlParameter
        Params(0) = New SqlClient.SqlParameter("@RecordCount", SqlDbType.Int, 8, ParameterDirection.Output, False, CType(0, Byte), CType(0, Byte), "", DataRowVersion.Current, 0)
        Params(1) = New SqlClient.SqlParameter("@QueryStr", SqlDbType.NVarChar, 1000, ParameterDirection.Input, False, CType(0, Byte), CType(0, Byte), "", DataRowVersion.Current, fnQueryTable.ToString)
        Params(2) = New SqlClient.SqlParameter("@PageSize", SqlDbType.Int, 8, ParameterDirection.Input, False, CType(0, Byte), CType(0, Byte), "", DataRowVersion.Current, fnPageSize)
        Params(3) = New SqlClient.SqlParameter("@PageCurrent", SqlDbType.Int, 8, ParameterDirection.Input, False, CType(0, Byte), CType(0, Byte), "", DataRowVersion.Current, fnPageCurrent)
        Params(4) = New SqlClient.SqlParameter("@FdShow", SqlDbType.NVarChar, 1000, ParameterDirection.Input, False, CType(0, Byte), CType(0, Byte), "", DataRowVersion.Current, fnFdShow.ToString)
        Params(5) = New SqlClient.SqlParameter("@FdOrder", SqlDbType.NVarChar, 1000, ParameterDirection.Input, False, CType(0, Byte), CType(0, Byte), "", DataRowVersion.Current, fnFdOrder.ToString)
        Params(6) = New SqlClient.SqlParameter("@FdWhere", SqlDbType.NVarChar, 1000, ParameterDirection.Input, False, CType(0, Byte), CType(0, Byte), "", DataRowVersion.Current, fnWhere)
        ExecProc("[sp_XmlSelect]", Params, pXmlDoc)
        Return CLng(Params(0).Value)
    End Function

    Public Function GetAllOptions() As System.Xml.XPath.XPathDocument
        Dim xPathDoc As System.Xml.XPath.XPathDocument = Nothing
        ExecProc("[sp_XmlGetOptions]", Nothing, xPathDoc)
        Return xPathDoc
    End Function

    Public Function GetListXPath(ByVal fnQueryTable As String, ByVal fnPageSize As Integer, ByVal fnPageCurrent As Long, ByVal fnFdShow As String, ByVal fnFdOrder As String, ByVal fnWhere As String, ByRef xPathDoc As System.Xml.XPath.XPathDocument) As Long
        Dim Params(6) As SqlClient.SqlParameter
        Params(0) = New SqlClient.SqlParameter("@RecordCount", SqlDbType.Int, 8, ParameterDirection.Output, False, CType(0, Byte), CType(0, Byte), "", DataRowVersion.Current, 0)
        Params(1) = New SqlClient.SqlParameter("@QueryStr", SqlDbType.NVarChar, 1000, ParameterDirection.Input, False, CType(0, Byte), CType(0, Byte), "", DataRowVersion.Current, fnQueryTable.ToString)
        Params(2) = New SqlClient.SqlParameter("@PageSize", SqlDbType.Int, 8, ParameterDirection.Input, False, CType(0, Byte), CType(0, Byte), "", DataRowVersion.Current, fnPageSize)
        Params(3) = New SqlClient.SqlParameter("@PageCurrent", SqlDbType.Int, 8, ParameterDirection.Input, False, CType(0, Byte), CType(0, Byte), "", DataRowVersion.Current, fnPageCurrent)
        Params(4) = New SqlClient.SqlParameter("@FdShow", SqlDbType.NVarChar, 1000, ParameterDirection.Input, False, CType(0, Byte), CType(0, Byte), "", DataRowVersion.Current, fnFdShow.ToString)
        Params(5) = New SqlClient.SqlParameter("@FdOrder", SqlDbType.NVarChar, 1000, ParameterDirection.Input, False, CType(0, Byte), CType(0, Byte), "", DataRowVersion.Current, fnFdOrder.ToString)
        Params(6) = New SqlClient.SqlParameter("@FdWhere", SqlDbType.NVarChar, 1000, ParameterDirection.Input, False, CType(0, Byte), CType(0, Byte), "", DataRowVersion.Current, fnWhere)
        If ExecProc("[sp_XmlSelect]", Params, xPathDoc) = -500 Then
            Return -500
        End If
        Return IIf(Params(0) Is Nothing, 0, CLng(Params(0).Value))
    End Function

    REM 用XML数据更新数据库
    Public Function UpdateFromXml(ByVal OuterXml As String, ByRef mReturnRowID As Integer) As Integer
        Dim Params(1) As SqlClient.SqlParameter
        Dim ReturnValue As Integer = -100
        Params(0) = New SqlClient.SqlParameter("@rowid", SqlDbType.Int, 4, ParameterDirection.Output, False, CType(0, Byte), CType(0, Byte), "", DataRowVersion.Current, 0)
        Params(1) = New SqlClient.SqlParameter("@doc", SqlDbType.NVarChar, 4000, ParameterDirection.Input, False, CType(0, Byte), CType(0, Byte), "", DataRowVersion.Current, OuterXml)

        ReturnValue = ExecProc("[sp_UpdateFromXml]", Params)
        If Params(0).Value Is Nothing Then
            mReturnRowID = 0
        Else
            mReturnRowID = CInt(Params(0).Value)
        End If
        Return ReturnValue
    End Function

    REM 默认设定为没有Where条件
    Public Function GetListXml(ByVal fnQueryTable As String, ByVal fnPageSize As Integer, ByVal fnPageCurrent As Long, ByVal fnFdShow As String, ByVal fnFdOrder As String, ByRef pXmlDoc As System.Xml.XmlReader) As Long
        Return GetListXml(fnQueryTable, fnPageSize, fnPageCurrent, fnFdShow, fnFdOrder, String.Empty, pXmlDoc)
    End Function

    REM 默认为第一行页数据
    Public Function GetListXml(ByVal fnQueryTable As String, ByVal fnPageSize As Integer, ByVal fnFdShow As String, ByVal fnFdOrder As String, ByRef pXmlDoc As System.Xml.XmlReader) As Long
        Return GetListXml(fnQueryTable, fnPageSize, 1, fnFdShow, fnFdOrder, pXmlDoc)
    End Function

    REM 读取存取过程
    Public Sub GetSpListXml(ByVal fnStoreProc As String, ByVal fnParamaters As String(), ByRef pXmlDoc As System.Xml.XmlReader)
        Dim Params(fnParamaters.Length - 1) As SqlClient.SqlParameter
        Try
            If fnParamaters.Length = 0 Then
                Params = Nothing
            Else
                For iLoop As Integer = 1 To fnParamaters.Length - 1
                    If fnParamaters(iLoop).IndexOf("=") > 1 Then
                        Params(iLoop - 1) = New SqlClient.SqlParameter("@" & fnParamaters(iLoop).Split(CChar("="))(0).Trim(), fnParamaters(iLoop).Split(CChar("="))(1).Trim())
                    End If
                Next
            End If
            ExecProc(fnStoreProc, Params, pXmlDoc)
        Catch ex As Exception
            mErrMessage = ex.Message
        End Try
    End Sub

    REM 读取存取过程
    Public Sub GetSpListXml(ByVal fnStoreProc As String, ByVal fnParamaters As String(), ByRef xPathDoc As System.Xml.XPath.XPathDocument)

        Dim Params(fnParamaters.Length - 1) As SqlClient.SqlParameter
        Try
            If fnParamaters.Length = 0 Then
                Params = Nothing
            Else
                For iLoop As Integer = 1 To fnParamaters.Length - 1
                    If fnParamaters(iLoop).IndexOf("=") > 1 Then
                        Params(iLoop - 1) = New SqlClient.SqlParameter("@" & fnParamaters(iLoop).Split(CChar("="))(0).Trim(), fnParamaters(iLoop).Split(CChar("="))(1).Trim())
                    End If
                Next
            End If
            ExecProc(fnStoreProc, Params, xPathDoc)
        Catch ex As Exception
            xPathDoc = Nothing
            mErrMessage = ex.Message
        End Try

    End Sub

    ''' <summary>
    ''' 运行函数
    ''' </summary>
    ''' <param name="fnParamaters"></param>
    ''' <param name="mErr"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function doFunction(ByVal fnParamaters As String(), ByRef mErr As String) As Integer
        Dim fnStoreProc As String = Regex.Replace(fnParamaters(0), "^{SP:(?<1>[a-zA-Z_0-9._]+)}$", "$1", RegexOptions.IgnoreCase)
        If String.IsNullOrEmpty(fnStoreProc) Then
            mErr = String.Format("不存在此事件[{0}]", fnParamaters(0))
            Return 0
        End If

        Dim Params(fnParamaters.Length - 1) As SqlClient.SqlParameter

        Dim ReturnValue As Integer = -100
        Try
            If fnParamaters.Length = 0 Then
                Params = Nothing
            Else
                For iLoop As Integer = 0 To Params.Length - 1
                    If fnParamaters(iLoop).IndexOf("=") > 1 Then
                        Params(iLoop) = New SqlClient.SqlParameter("@" & fnParamaters(iLoop).Split(CChar("="))(0).Trim(), fnParamaters(iLoop).Split(CChar("="))(1).Trim())
                    End If
                Next
            End If
            ReturnValue = ExecProc(fnStoreProc, Params, mErr)
        Catch ex As Exception
            ReturnValue = 501
            mErrMessage = ex.Message
        End Try

        Return ReturnValue
    End Function

    REM 更新数据库事件
    Public Function UpdateEvent(ByVal fnParamaters As String(), ByRef mErr As String) As Integer
        Dim fnStoreProc As String = Regex.Replace(fnParamaters(0), "^{SP:(?<1>[a-zA-Z_0-9._]+)}$", "$1", RegexOptions.IgnoreCase)
        If String.IsNullOrEmpty(fnStoreProc) Then
            mErr = String.Format("不存在此事件[{0}]", fnParamaters(0))
            Return 0
        End If

        Dim Params(fnParamaters.Length - 1) As SqlClient.SqlParameter

        Dim ReturnValue As Integer = -100
        Params(0) = New SqlClient.SqlParameter("@err", SqlDbType.NVarChar, 1000, ParameterDirection.Output, False, CType(0, Byte), CType(0, Byte), "", DataRowVersion.Current, mErr)

        Try
            If fnParamaters.Length = 0 Then
                Params = Nothing
            Else
                For iLoop As Integer = 1 To fnParamaters.Length - 1
                    If fnParamaters(iLoop).IndexOf("=") > 1 Then
                        Params(iLoop) = New SqlClient.SqlParameter("@" & fnParamaters(iLoop).Split(CChar("="))(0).Trim(), fnParamaters(iLoop).Split(CChar("="))(1).Trim())
                    End If
                Next
            End If
            ReturnValue = ExecProc(fnStoreProc, Params)
        Catch ex As Exception
            ReturnValue = 501
            mErrMessage = ex.Message
        End Try

        If Params(0).Value Is Nothing Then
            mErr = mErrMessage
        Else
            mErr = Params(0).Value
        End If
        Return ReturnValue
    End Function


#End Region

#Region "创建数据库对象区 GetSqlConn , GetSqlCmd"
    REM 创建数据库连接
    Public Shared Function GetSqlConn(ByVal fKey As String) As SqlClient.SqlConnection

        Return New SqlClient.SqlConnection(ConnString(fKey))
    End Function

    REM 设定数据库连接,默认数据库default
    Public Function GetSqlConn() As SqlClient.SqlConnection
        Return GetSqlConn(UriKey)
    End Function

    REM 创建SqlCommand
    Private Function GetSqlCmd(ByVal ProcName As String, ByVal Params As SqlClient.SqlParameter()) As SqlClient.SqlCommand
        Using SqlCmd As SqlClient.SqlCommand = New SqlClient.SqlCommand(ProcName, Conn)
            SqlCmd.CommandType = CommandType.StoredProcedure
            REM 加载参数
            If Not Params Is Nothing Then
                Dim SqlParam As SqlClient.SqlParameter
                For Each SqlParam In Params
                    If Not SqlParam Is Nothing Then SqlCmd.Parameters.Add(SqlParam)
                Next
            End If
            REM 增加默认的返回值参数
            SqlCmd.Parameters.Add(New SqlClient.SqlParameter("ReturnValue", SqlDbType.Int, 4, ParameterDirection.ReturnValue, False, 0, 0, String.Empty, DataRowVersion.Default, Nothing))
            Return SqlCmd
        End Using
    End Function

    REM 创建SqlCommand
    Private Function GetSqlCmd(ByVal Sql As String) As SqlClient.SqlCommand
        Using SqlCmd As SqlClient.SqlCommand = New SqlClient.SqlCommand(Sql, Conn)
            SqlCmd.CommandType = CommandType.Text
            Return SqlCmd
        End Using
    End Function
#End Region

    Private disposedValue As Boolean = False        ' 检测冗余的调用

    ' IDisposable
    Protected Overridable Sub Dispose(ByVal disposing As Boolean)
        If Not Me.disposedValue Then
            If disposing Then
                ' TODO: 释放其他状态(托管对象)。
            End If

            REM 释放资源
            If Not mConn Is Nothing Then
                If mConn.State = ConnectionState.Open Then
                    mConn.Close()
                End If
                mConn.Dispose()
                mConn = Nothing
            End If
            ' TODO: 释放您自己的状态(非托管对象)。
            ' TODO: 将大型字段设置为 null。
        End If
        Me.disposedValue = True
    End Sub

#Region " IDisposable Support "
    ' Visual Basic 添加此代码是为了正确实现可处置模式。
    Public Sub Dispose() Implements IDisposable.Dispose
        ' 不要更改此代码。请将清理代码放入上面的 Dispose(ByVal disposing As Boolean) 中。
        Dispose(True)
        GC.SuppressFinalize(Me)
    End Sub
#End Region

End Class

